home *** CD-ROM | disk | FTP | other *** search
/ IRIX 5.3 for Indy R4400 / IRIX 5.3 for Indy R4400 175MHz.img / dist / eoe2.idb / usr / sbin / s2p.z / s2p
Text File  |  1995-02-28  |  14KB  |  762 lines
  1. #!/usr/local/bin/perl
  2.  
  3. eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
  4.     if $running_under_some_shell;
  5.  
  6. $bin = '/usr/local/bin';
  7.  
  8. # $RCSfile: s2p,v $$Revision: 1.1 $$Date: 1993/05/14 20:18:13 $
  9. #
  10. # $Log: s2p,v $
  11. # Revision 1.1  1993/05/14  20:18:13  cwilson
  12. # Initial revision
  13. #
  14. # Revision 4.0.1.2  92/06/08  17:26:31  lwall
  15. # patch20: s2p didn't output portable startup code
  16. # patch20: added ... as variant on ..
  17. # patch20: s2p didn't translate s/pat/\&/ or s/pat/\$/ or s/pat/\\1/ right
  18. # 
  19. # Revision 4.0.1.1  91/06/07  12:19:18  lwall
  20. # patch4: s2p now handles embedded newlines better and optimizes common idioms
  21. # 
  22. # Revision 4.0  91/03/20  01:57:59  lwall
  23. # 4.0 baseline.
  24. # 
  25. #
  26.  
  27. $indent = 4;
  28. $shiftwidth = 4;
  29. $l = '{'; $r = '}';
  30.  
  31. while ($ARGV[0] =~ /^-/) {
  32.     $_ = shift;
  33.   last if /^--/;
  34.     if (/^-D/) {
  35.     $debug++;
  36.     open(BODY,'>-');
  37.     next;
  38.     }
  39.     if (/^-n/) {
  40.     $assumen++;
  41.     next;
  42.     }
  43.     if (/^-p/) {
  44.     $assumep++;
  45.     next;
  46.     }
  47.     die "I don't recognize this switch: $_\n";
  48. }
  49.  
  50. unless ($debug) {
  51.     open(BODY,">/tmp/sperl$$") ||
  52.       &Die("Can't open temp file: $!\n");
  53. }
  54.  
  55. if (!$assumen && !$assumep) {
  56.     print BODY &q(<<'EOT');
  57. :    while ($ARGV[0] =~ /^-/) {
  58. :        $_ = shift;
  59. :      last if /^--/;
  60. :        if (/^-n/) {
  61. :        $nflag++;
  62. :        next;
  63. :        }
  64. :        die "I don't recognize this switch: $_\\n";
  65. :    }
  66. :    
  67. EOT
  68. }
  69.  
  70. print BODY &q(<<'EOT');
  71. :    #ifdef PRINTIT
  72. :    #ifdef ASSUMEP
  73. :    $printit++;
  74. :    #else
  75. :    $printit++ unless $nflag;
  76. :    #endif
  77. :    #endif
  78. :    <><>
  79. :    $\ = "\n";        # automatically add newline on print
  80. :    <><>
  81. :    #ifdef TOPLABEL
  82. :    LINE:
  83. :    while (chop($_ = <>)) {
  84. :    #else
  85. :    LINE:
  86. :    while (<>) {
  87. :        chop;
  88. :    #endif
  89. EOT
  90.  
  91. LINE:
  92. while (<>) {
  93.  
  94.     # Wipe out surrounding whitespace.
  95.  
  96.     s/[ \t]*(.*)\n$/$1/;
  97.  
  98.     # Perhaps it's a label/comment.
  99.  
  100.     if (/^:/) {
  101.     s/^:[ \t]*//;
  102.     $label = &make_label($_);
  103.     if ($. == 1) {
  104.         $toplabel = $label;
  105.         if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
  106.         $_ = <>;
  107.         redo LINE; # Never referenced, so delete it if not a comment.
  108.         }
  109.     }
  110.     $_ = "$label:";
  111.     if ($lastlinewaslabel++) {
  112.         $indent += 4;
  113.         print BODY &tab, ";\n";
  114.         $indent -= 4;
  115.     }
  116.     if ($indent >= 2) {
  117.         $indent -= 2;
  118.         $indmod = 2;
  119.     }
  120.     next;
  121.     } else {
  122.     $lastlinewaslabel = '';
  123.     }
  124.  
  125.     # Look for one or two address clauses
  126.  
  127.     $addr1 = '';
  128.     $addr2 = '';
  129.     if (s/^([0-9]+)//) {
  130.     $addr1 = "$1";
  131.     $addr1 = "\$. == $addr1" unless /^,/;
  132.     }
  133.     elsif (s/^\$//) {
  134.     $addr1 = 'eof()';
  135.     }
  136.     elsif (s|^/||) {
  137.     $addr1 = &fetchpat('/');
  138.     }
  139.     if (s/^,//) {
  140.     if (s/^([0-9]+)//) {
  141.         $addr2 = "$1";
  142.     } elsif (s/^\$//) {
  143.         $addr2 = "eof()";
  144.     } elsif (s|^/||) {
  145.         $addr2 = &fetchpat('/');
  146.     } else {
  147.         &Die("Invalid second address at line $.\n");
  148.     }
  149.     if ($addr2 =~ /^\d+$/) {
  150.         $addr1 .= "..$addr2";
  151.     }
  152.     else {
  153.         $addr1 .= "...$addr2";
  154.     }
  155.     }
  156.  
  157.     # Now we check for metacommands {, }, and ! and worry
  158.     # about indentation.
  159.  
  160.     s/^[ \t]+//;
  161.     # a { to keep vi happy
  162.     if ($_ eq '}') {
  163.     $indent -= 4;
  164.     next;
  165.     }
  166.     if (s/^!//) {
  167.     $if = 'unless';
  168.     $else = "$r else $l\n";
  169.     } else {
  170.     $if = 'if';
  171.     $else = '';
  172.     }
  173.     if (s/^{//) {    # a } to keep vi happy
  174.     $indmod = 4;
  175.     $redo = $_;
  176.     $_ = '';
  177.     $rmaybe = '';
  178.     } else {
  179.     $rmaybe = "\n$r";
  180.     if ($addr2 || $addr1) {
  181.         $space = ' ' x $shiftwidth;
  182.     } else {
  183.         $space = '';
  184.     }
  185.     $_ = &transmogrify();
  186.     }
  187.  
  188.     # See if we can optimize to modifier form.
  189.  
  190.     if ($addr1) {
  191.     if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
  192.       $_ !~ / if / && $_ !~ / unless /) {
  193.         s/;$/ $if $addr1;/;
  194.         $_ = substr($_,$shiftwidth,1000);
  195.     } else {
  196.         $_ = "$if ($addr1) $l\n$change$_$rmaybe";
  197.     }
  198.     $change = '';
  199.     next LINE;
  200.     }
  201. } continue {
  202.     @lines = split(/\n/,$_);
  203.     for (@lines) {
  204.     unless (s/^ *<<--//) {
  205.         print BODY &tab;
  206.     }
  207.     print BODY $_, "\n";
  208.     }
  209.     $indent += $indmod;
  210.     $indmod = 0;
  211.     if ($redo) {
  212.     $_ = $redo;
  213.     $redo = '';
  214.     redo LINE;
  215.     }
  216. }
  217. if ($lastlinewaslabel++) {
  218.     $indent += 4;
  219.     print BODY &tab, ";\n";
  220.     $indent -= 4;
  221. }
  222.  
  223. if ($appendseen || $tseen || !$assumen) {
  224.     $printit++ if $dseen || (!$assumen && !$assumep);
  225.     print BODY &q(<<'EOT');
  226. :    #ifdef SAWNEXT
  227. :    }
  228. :    continue {
  229. :    #endif
  230. :    #ifdef PRINTIT
  231. :    #ifdef DSEEN
  232. :    #ifdef ASSUMEP
  233. :        print if $printit++;
  234. :    #else
  235. :        if ($printit)
  236. :        { print; }
  237. :        else
  238. :        { $printit++ unless $nflag; }
  239. :    #endif
  240. :    #else
  241. :        print if $printit;
  242. :    #endif
  243. :    #else
  244. :        print;
  245. :    #endif
  246. :    #ifdef TSEEN
  247. :        $tflag = 0;
  248. :    #endif
  249. :    #ifdef APPENDSEEN
  250. :        if ($atext) { chop $atext; print $atext; $atext = ''; }
  251. :    #endif
  252. EOT
  253.  
  254. print BODY &q(<<'EOT');
  255. :    }
  256. EOT
  257. }
  258.  
  259. close BODY;
  260.  
  261. unless ($debug) {
  262.     open(HEAD,">/tmp/sperl2$$.c")
  263.       || &Die("Can't open temp file 2: $!\n");
  264.     print HEAD "#define PRINTIT\n"    if $printit;
  265.     print HEAD "#define APPENDSEEN\n"    if $appendseen;
  266.     print HEAD "#define TSEEN\n"    if $tseen;
  267.     print HEAD "#define DSEEN\n"    if $dseen;
  268.     print HEAD "#define ASSUMEN\n"    if $assumen;
  269.     print HEAD "#define ASSUMEP\n"    if $assumep;
  270.     print HEAD "#define TOPLABEL\n"    if $toplabel;
  271.     print HEAD "#define SAWNEXT\n"    if $sawnext;
  272.     if ($opens) {print HEAD "$opens\n";}
  273.     open(BODY,"/tmp/sperl$$")
  274.       || &Die("Can't reopen temp file: $!\n");
  275.     while (<BODY>) {
  276.     print HEAD $_;
  277.     }
  278.     close HEAD;
  279.  
  280.     print &q(<<"EOT");
  281. :    #!$bin/perl
  282. :    eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  283. :        if \$running_under_some_shell;
  284. :    
  285. EOT
  286.     open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  287.     &Die("Can't reopen temp file: $!\n");
  288.     while (<BODY>) {
  289.     /^# [0-9]/ && next;
  290.     /^[ \t]*$/ && next;
  291.     s/^<><>//;
  292.     print;
  293.     }
  294. }
  295.  
  296. &Cleanup;
  297. exit;
  298.  
  299. sub Cleanup {
  300.     chdir "/tmp";
  301.     unlink "sperl$$", "sperl2$$", "sperl2$$.c";
  302. }
  303. sub Die {
  304.     &Cleanup;
  305.     die $_[0];
  306. }
  307. sub tab {
  308.     "\t" x ($indent / 8) . ' ' x ($indent % 8);
  309. }
  310. sub make_filehandle {
  311.     local($_) = $_[0];
  312.     local($fname) = $_;
  313.     if (!$seen{$fname}) {
  314.     $_ = "FH_" . $_ if /^\d/;
  315.     s/[^a-zA-Z0-9]/_/g;
  316.     s/^_*//;
  317.     $_ = "\U$_";
  318.     if ($fhseen{$_}) {
  319.         for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
  320.         $_ .= $tmp;
  321.     }
  322.     $fhseen{$_} = 1;
  323.     $opens .= &q(<<"EOT");
  324. :    open($_, '>$fname') || die "Can't create $fname: \$!";
  325. EOT
  326.     $seen{$fname} = $_;
  327.     }
  328.     $seen{$fname};
  329. }
  330.  
  331. sub make_label {
  332.     local($label) = @_;
  333.     $label =~ s/[^a-zA-Z0-9]/_/g;
  334.     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
  335.     $label = substr($label,0,8);
  336.  
  337.     # Could be a reserved word, so capitalize it.
  338.     substr($label,0,1) =~ y/a-z/A-Z/
  339.       if $label =~ /^[a-z]/;
  340.  
  341.     $label;
  342. }
  343.  
  344. sub transmogrify {
  345.     {    # case
  346.     if (/^d/) {
  347.         $dseen++;
  348.         chop($_ = &q(<<'EOT'));
  349. :    <<--#ifdef PRINTIT
  350. :    $printit = 0;
  351. :    <<--#endif
  352. :    next LINE;
  353. EOT
  354.         $sawnext++;
  355.         next;
  356.     }
  357.  
  358.     if (/^n/) {
  359.         chop($_ = &q(<<'EOT'));
  360. :    <<--#ifdef PRINTIT
  361. :    <<--#ifdef DSEEN
  362. :    <<--#ifdef ASSUMEP
  363. :    print if $printit++;
  364. :    <<--#else
  365. :    if ($printit)
  366. :        { print; }
  367. :    else
  368. :        { $printit++ unless $nflag; }
  369. :    <<--#endif
  370. :    <<--#else
  371. :    print if $printit;
  372. :    <<--#endif
  373. :    <<--#else
  374. :    print;
  375. :    <<--#endif
  376. :    <<--#ifdef APPENDSEEN
  377. :    if ($atext) {chop $atext; print $atext; $atext = '';}
  378. :    <<--#endif
  379. :    $_ = <>;
  380. :    chop;
  381. :    <<--#ifdef TSEEN
  382. :    $tflag = 0;
  383. :    <<--#endif
  384. EOT
  385.         next;
  386.     }
  387.  
  388.     if (/^a/) {
  389.         $appendseen++;
  390.         $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  391.         $lastline = 0;
  392.         while (<>) {
  393.         s/^[ \t]*//;
  394.         s/^[\\]//;
  395.         unless (s|\\$||) { $lastline = 1;}
  396.         s/^([ \t]*\n)/<><>$1/;
  397.         $command .= $_;
  398.         $command .= '<<--';
  399.         last if $lastline;
  400.         }
  401.         $_ = $command . "End_Of_Text";
  402.         last;
  403.     }
  404.  
  405.     if (/^[ic]/) {
  406.         if (/^c/) { $change = 1; }
  407.         $addr1 = 1 if $addr1 eq '';
  408.         $addr1 = '$iter = (' . $addr1 . ')';
  409.         $command = $space .
  410.           "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
  411.         $lastline = 0;
  412.         while (<>) {
  413.         s/^[ \t]*//;
  414.         s/^[\\]//;
  415.         unless (s/\\$//) { $lastline = 1;}
  416.         s/'/\\'/g;
  417.         s/^([ \t]*\n)/<><>$1/;
  418.         $command .= $_;
  419.         $command .= '<<--';
  420.         last if $lastline;
  421.         }
  422.         $_ = $command . "End_Of_Text";
  423.         if ($change) {
  424.         $dseen++;
  425.         $change = "$_\n";
  426.         chop($_ = &q(<<"EOT"));
  427. :    <<--#ifdef PRINTIT
  428. :    $space\$printit = 0;
  429. :    <<--#endif
  430. :    ${space}next LINE;
  431. EOT
  432.         $sawnext++;
  433.         }
  434.         last;
  435.     }
  436.  
  437.     if (/^s/) {
  438.         $delim = substr($_,1,1);
  439.         $len = length($_);
  440.         $repl = $end = 0;
  441.         $inbracket = 0;
  442.         for ($i = 2; $i < $len; $i++) {
  443.         $c = substr($_,$i,1);
  444.         if ($c eq $delim) {
  445.             if ($inbracket) {
  446.             substr($_, $i, 0) = '\\';
  447.             $i++;
  448.             $len++;
  449.             }
  450.             else {
  451.             if ($repl) {
  452.                 $end = $i;
  453.                 last;
  454.             } else {
  455.                 $repl = $i;
  456.             }
  457.             }
  458.         }
  459.         elsif ($c eq '\\') {
  460.             $i++;
  461.             if ($i >= $len) {
  462.             $_ .= 'n';
  463.             $_ .= <>;
  464.             $len = length($_);
  465.             $_ = substr($_,0,--$len);
  466.             }
  467.             elsif (substr($_,$i,1) =~ /^[n]$/) {
  468.             ;
  469.             }
  470.             elsif (!$repl &&
  471.               substr($_,$i,1) =~ /^[(){}\w]$/) {
  472.             $i--;
  473.             $len--;
  474.             substr($_, $i, 1) = '';
  475.             }
  476.             elsif (!$repl &&
  477.               substr($_,$i,1) =~ /^[<>]$/) {
  478.             substr($_,$i,1) = 'b';
  479.             }
  480.             elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
  481.             substr($_,$i-1,1) = '$';
  482.             }
  483.         }
  484.         elsif ($c eq '&' && $repl) {
  485.             substr($_, $i, 0) = '$';
  486.             $i++;
  487.             $len++;
  488.         }
  489.         elsif ($c eq '$' && $repl) {
  490.             substr($_, $i, 0) = '\\';
  491.             $i++;
  492.             $len++;
  493.         }
  494.         elsif ($c eq '[' && !$repl) {
  495.             $i++ if substr($_,$i,1) eq '^';
  496.             $i++ if substr($_,$i,1) eq ']';
  497.             $inbracket = 1;
  498.         }
  499.         elsif ($c eq ']') {
  500.             $inbracket = 0;
  501.         }
  502.         elsif ($c eq "\t") {
  503.             substr($_, $i, 1) = '\\t';
  504.             $i++;
  505.             $len++;
  506.         }
  507.         elsif (!$repl && index("()+",$c) >= 0) {
  508.             substr($_, $i, 0) = '\\';
  509.             $i++;
  510.             $len++;
  511.         }
  512.         }
  513.         &Die("Malformed substitution at line $.\n")
  514.           unless $end;
  515.         $pat = substr($_, 0, $repl + 1);
  516.         $repl = substr($_, $repl+1, $end-$repl-1);
  517.         $end = substr($_, $end + 1, 1000);
  518.         &simplify($pat);
  519.         $dol = '$';
  520.         $subst = "$pat$repl$delim";
  521.         $cmd = '';
  522.         while ($end) {
  523.         if ($end =~ s/^g//) {
  524.             $subst .= 'g';
  525.             next;
  526.         }
  527.         if ($end =~ s/^p//) {
  528.             $cmd .= ' && (print)';
  529.             next;
  530.         }
  531.         if ($end =~ s/^w[ \t]*//) {
  532.             $fh = &make_filehandle($end);
  533.             $cmd .= " && (print $fh \$_)";
  534.             $end = '';
  535.             next;
  536.         }
  537.         &Die("Unrecognized substitution command".
  538.           "($end) at line $.\n");
  539.         }
  540.         chop ($_ = &q(<<"EOT"));
  541. :    <<--#ifdef TSEEN
  542. :    $subst && \$tflag++$cmd;
  543. :    <<--#else
  544. :    $subst$cmd;
  545. :    <<--#endif
  546. EOT
  547.         next;
  548.     }
  549.  
  550.     if (/^p/) {
  551.         $_ = 'print;';
  552.         next;
  553.     }
  554.  
  555.     if (/^w/) {
  556.         s/^w[ \t]*//;
  557.         $fh = &make_filehandle($_);
  558.         $_ = "print $fh \$_;";
  559.         next;
  560.     }
  561.  
  562.     if (/^r/) {
  563.         $appendseen++;
  564.         s/^r[ \t]*//;
  565.         $file = $_;
  566.         $_ = "\$atext .= `cat $file 2>/dev/null`;";
  567.         next;
  568.     }
  569.  
  570.     if (/^P/) {
  571.         $_ = 'print $1 if /^(.*)/;';
  572.         next;
  573.     }
  574.  
  575.     if (/^D/) {
  576.         chop($_ = &q(<<'EOT'));
  577. :    s/^.*\n?//;
  578. :    redo LINE if $_;
  579. :    next LINE;
  580. EOT
  581.         $sawnext++;
  582.         next;
  583.     }
  584.  
  585.     if (/^N/) {
  586.         chop($_ = &q(<<'EOT'));
  587. :    $_ .= "\n";
  588. :    $len1 = length;
  589. :    $_ .= <>;
  590. :    chop if $len1 < length;
  591. :    <<--#ifdef TSEEN
  592. :    $tflag = 0;
  593. :    <<--#endif
  594. EOT
  595.         next;
  596.     }
  597.  
  598.     if (/^h/) {
  599.         $_ = '$hold = $_;';
  600.         next;
  601.     }
  602.  
  603.     if (/^H/) {
  604.         $_ = '$hold .= "\n"; $hold .= $_;';
  605.         next;
  606.     }
  607.  
  608.     if (/^g/) {
  609.         $_ = '$_ = $hold;';
  610.         next;
  611.     }
  612.  
  613.     if (/^G/) {
  614.         $_ = '$_ .= "\n"; $_ .= $hold;';
  615.         next;
  616.     }
  617.  
  618.     if (/^x/) {
  619.         $_ = '($_, $hold) = ($hold, $_);';
  620.         next;
  621.     }
  622.  
  623.     if (/^b$/) {
  624.         $_ = 'next LINE;';
  625.         $sawnext++;
  626.         next;
  627.     }
  628.  
  629.     if (/^b/) {
  630.         s/^b[ \t]*//;
  631.         $lab = &make_label($_);
  632.         if ($lab eq $toplabel) {
  633.         $_ = 'redo LINE;';
  634.         } else {
  635.         $_ = "goto $lab;";
  636.         }
  637.         next;
  638.     }
  639.  
  640.     if (/^t$/) {
  641.         $_ = 'next LINE if $tflag;';
  642.         $sawnext++;
  643.         $tseen++;
  644.         next;
  645.     }
  646.  
  647.     if (/^t/) {
  648.         s/^t[ \t]*//;
  649.         $lab = &make_label($_);
  650.         $_ = q/if ($tflag) {$tflag = 0; /;
  651.         if ($lab eq $toplabel) {
  652.         $_ .= 'redo LINE;}';
  653.         } else {
  654.         $_ .= "goto $lab;}";
  655.         }
  656.         $tseen++;
  657.         next;
  658.     }
  659.  
  660.     if (/^y/) {
  661.         s/abcdefghijklmnopqrstuvwxyz/a-z/g;
  662.         s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
  663.         s/abcdef/a-f/g;
  664.         s/ABCDEF/A-F/g;
  665.         s/0123456789/0-9/g;
  666.         s/01234567/0-7/g;
  667.         $_ .= ';';
  668.     }
  669.  
  670.     if (/^=/) {
  671.         $_ = 'print $.;';
  672.         next;
  673.     }
  674.  
  675.     if (/^q/) {
  676.         chop($_ = &q(<<'EOT'));
  677. :    close(ARGV);
  678. :    @ARGV = ();
  679. :    next LINE;
  680. EOT
  681.         $sawnext++;
  682.         next;
  683.     }
  684.     } continue {
  685.     if ($space) {
  686.         s/^/$space/;
  687.         s/(\n)(.)/$1$space$2/g;
  688.     }
  689.     last;
  690.     }
  691.     $_;
  692. }
  693.  
  694. sub fetchpat {
  695.     local($outer) = @_;
  696.     local($addr) = $outer;
  697.     local($inbracket);
  698.     local($prefix,$delim,$ch);
  699.  
  700.     # Process pattern one potential delimiter at a time.
  701.  
  702.     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
  703.     $prefix = $1;
  704.     $delim = $2;
  705.     if ($delim eq '\\') {
  706.         s/(.)//;
  707.         $ch = $1;
  708.         $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
  709.         $ch = 'b' if $ch =~ /^[<>]$/;
  710.         $delim .= $ch;
  711.     }
  712.     elsif ($delim eq '[') {
  713.         $inbracket = 1;
  714.         s/^\^// && ($delim .= '^');
  715.         s/^]// && ($delim .= ']');
  716.     }
  717.     elsif ($delim eq ']') {
  718.         $inbracket = 0;
  719.     }
  720.     elsif ($inbracket || $delim ne $outer) {
  721.         $delim = '\\' . $delim;
  722.     }
  723.     $addr .= $prefix;
  724.     $addr .= $delim;
  725.     if ($delim eq $outer && !$inbracket) {
  726.         last DELIM;
  727.     }
  728.     }
  729.     $addr =~ s/\t/\\t/g;
  730.     &simplify($addr);
  731.     $addr;
  732. }
  733.  
  734. sub q {
  735.     local($string) = @_;
  736.     local($*) = 1;
  737.     $string =~ s/^:\t?//g;
  738.     $string;
  739. }
  740.  
  741. sub simplify {
  742.     $_[0] =~ s/_a-za-z0-9/\\w/ig;
  743.     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
  744.     $_[0] =~ s/a-za-z_0-9/\\w/ig;
  745.     $_[0] =~ s/a-za-z0-9_/\\w/ig;
  746.     $_[0] =~ s/_0-9a-za-z/\\w/ig;
  747.     $_[0] =~ s/0-9_a-za-z/\\w/ig;
  748.     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
  749.     $_[0] =~ s/0-9a-za-z_/\\w/ig;
  750.     $_[0] =~ s/\[\\w\]/\\w/g;
  751.     $_[0] =~ s/\[^\\w\]/\\W/g;
  752.     $_[0] =~ s/\[0-9\]/\\d/g;
  753.     $_[0] =~ s/\[^0-9\]/\\D/g;
  754.     $_[0] =~ s/\\d\\d\*/\\d+/g;
  755.     $_[0] =~ s/\\D\\D\*/\\D+/g;
  756.     $_[0] =~ s/\\w\\w\*/\\w+/g;
  757.     $_[0] =~ s/\\t\\t\*/\\t+/g;
  758.     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
  759.     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
  760. }
  761.  
  762.